# This is a slightly adjusted copy of the
# cjoint::read.qualtrics function
# it takes an R object as input

read_qualtrics <- function (df_object, responses, covariates = NULL, respondentID = NULL) 
{
  if (is.null(responses)) {
    stop("responses cannot be NULL")
    return(NULL)
  }
  qualtrics_results <- df_object
  var_names <- as.character(qualtrics_results[1, ])
  q_names <- colnames(qualtrics_results)
  qualtrics_results <- qualtrics_results[2:nrow(qualtrics_results), 
                                         ]
  colnames(qualtrics_results) <- var_names
  attr_name_cols <- var_names[grep("F-[0-9]+-[0-9]+(?!-)", 
                                   var_names, perl = TRUE)]
  if (length(attr_name_cols) == 0) {
    stop("Error: Cannot find any columns designating attributes and levels. Please make sure the input file originated from a Qualtrics survey designed using the Conjoint SDT")
    return(NULL)
  }
  for (attr_column in attr_name_cols) {
    if (is.null(unique(qualtrics_results[, attr_column]))) {
      stop(paste("Error, attribute column ", attr_column, 
                 " has no attribute names - recommend deleting this column"))
    }
    else if (unique(qualtrics_results[, attr_column])[1] == 
             "" & length(unique(qualtrics_results[, attr_column])) == 
             1) {
      stop(paste("Error, attribute column ", attr_column, 
                 " has no attribute names - recommend deleting this column"))
    }
  }
  attr_name_matrix <- matrix(unlist(strsplit(attr_name_cols, 
                                             "-")), nrow = 3, ncol = length(attr_name_cols))
  colnames(attr_name_matrix) <- attr_name_cols
  attr_name_matrix <- attr_name_matrix[2:nrow(attr_name_matrix), 
                                       ]
  attr_name_matrix <- as.data.frame(t(attr_name_matrix))
  num_tasks <- unique(as.integer(attr_name_matrix[, 1]))
  if (length(num_tasks) != length(responses)) {
    cat("Error: Number of response columns doesn't equal number of tasks in data")
    return(NULL)
  }
  level_name_cols <- var_names[grep("F-[0-9]+-[0-9]+-[0-9]", 
                                    var_names, perl = TRUE)]
  for (lev_column in level_name_cols) {
    if (is.null(unique(qualtrics_results[, lev_column]))) {
      stop(paste("Error, level column ", lev_column, " has no attribute names - recommend deleting this column"))
    }
    else if (unique(qualtrics_results[, lev_column])[1] == 
             "" & length(unique(qualtrics_results[, lev_column])) == 
             1) {
      stop(paste("Error, level column ", lev_column, " has no attribute names - recommend deleting this column"))
    }
  }
  level_name_matrix <- matrix(unlist(strsplit(level_name_cols, 
                                              "-")), nrow = 4, ncol = length(level_name_cols))
  colnames(level_name_matrix) <- level_name_cols
  level_name_matrix <- level_name_matrix[2:nrow(level_name_matrix), 
                                         ]
  level_name_matrix <- as.data.frame(t(level_name_matrix))
  if (!is.null(respondentID)) {
    respondent_index <- qualtrics_results[, which(q_names %in% 
                                                    respondentID)]
  }
  else {
    respondent_index <- 1:nrow(qualtrics_results)
  }
  if (is.character(responses[1])) {
    response_vars <- which(q_names %in% responses)
  }
  else {
    response_vars <- responses
  }
  out_data_dataset <- NULL
  for (r in 1:nrow(qualtrics_results)) {
    skipRow = FALSE
    attribute_refs_1 <- rownames(attr_name_matrix[attr_name_matrix[, 
                                                                   1] == 1, ])
    attribute_vector_1 <- qualtrics_results[r, attribute_refs_1]
    if (is.na(attribute_vector_1[1])) {
      skipRow = TRUE
    }
    else if (attribute_vector_1[1] == "") {
      skipRow = TRUE
    }
    if (skipRow != TRUE) {
      if (!is.null(covariates)) {
        covariate_index <- which(q_names %in% covariates)
        covnames <- q_names[covariate_index]
        unit_cov <- qualtrics_results[r, covariate_index]
      }
      else {
        unit_cov <- c()
      }
      for (k in num_tasks) {
        attribute_refs <- rownames(attr_name_matrix[attr_name_matrix[, 
                                                                     1] == k, ])
        attribute_vector <- qualtrics_results[r, attribute_refs]
        num_profiles <- as.integer(unique(level_name_matrix[, 
                                                            2]))
        selec_num <- qualtrics_results[r, response_vars[k]]
        for (j in num_profiles) {
          profile_ref <- rownames(level_name_matrix[level_name_matrix[, 
                                                                      1] == k & level_name_matrix[, 2] == j, ])
          profile_levels <- qualtrics_results[r, profile_ref]
          names(profile_levels) <- attribute_vector
          if (is.na(as.integer(selec_num))) {
            selec <- NA
          }
          else if (as.integer(selec_num) == as.integer(j)) {
            selec <- 1
          }
          else {
            selec <- 0
          }
          if (!is.null(covariates)) {
            row_vec <- data.frame(r, respondent_index[r], 
                                  k, j, profile_levels, selec, unit_cov)
            header <- as.vector(unlist(c("respondentIndex", 
                                         "respondent", "task", "profile", attribute_vector, 
                                         "selected", covnames)))
            colnames(row_vec) <- header
          }
          else {
            row_vec <- data.frame(r, respondent_index[r], 
                                  k, j, profile_levels, selec)
            header <- as.vector(unlist(c("respondentIndex", 
                                         "respondent", "task", "profile", attribute_vector, 
                                         "selected")))
            colnames(row_vec) <- header
          }
          if (is.null(out_data_dataset)) {
            out_data_dataset <- row_vec
          }
          else {
            out_data_dataset <- rbind(out_data_dataset, 
                                      row_vec)
          }
        }
      }
    }
  }
  for (m in attribute_vector) {
    out_data_dataset[[m]] <- as.factor(out_data_dataset[[m]])
  }
  out_data_dataset$respondentIndex <- as.integer(out_data_dataset$respondentIndex)
  out_data_dataset$selected <- as.integer(out_data_dataset$selected)
  out_data_dataset$task <- as.integer(out_data_dataset$task)
  out_data_dataset$profile <- as.integer(out_data_dataset$profile)
  return(out_data_dataset)
}
